home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONX_FO / FMEMMON.C < prev    next >
Text File  |  1990-03-02  |  14KB  |  593 lines
  1. /*
  2.  *  fxmemmon.c -- mmout, mmpause, mmshow, and internal functions.
  3.  *
  4.  *   This file contains memory monitoring code.  It is compiled by inclusion
  5.  *   in fxtra.c if MemMon is defined.  When MemMon is undefined, most of the
  6.  *   "MMxxxx" entry points are defined as null macros in rt.h.
  7.  */
  8.  
  9. #include "::h:config.h"
  10. #include "::h:rt.h"
  11. #include "rproto.h"
  12.  
  13.  
  14. #ifdef PreProcess
  15. /* include(../M4/fncs.m4) /* */
  16. /* */
  17. #endif                    /* PreProcess */
  18.  
  19. #ifdef MemMon
  20. /*
  21.  * Prototypes.
  22.  */
  23.  
  24. hidden    novalue mmcmd        Params((word addr, word len, int c));
  25. hidden    novalue mmdec        Params((uword n));
  26. hidden    novalue mmforget    Params((noargs));
  27. hidden    novalue mmlen        Params((word n, int c));
  28. hidden    novalue mmnewline    Params((noargs));
  29. hidden    novalue mmrefresh    Params((noargs));
  30. hidden    novalue mmsizes        Params((int c));
  31. hidden    novalue mmstatic    Params((noargs));
  32. hidden    novalue MMOut        Params((char *prefix, char *msg));
  33.  
  34. static FILE *monfile = NULL;    /* output file pointer */
  35. static char *monname = NULL;    /* output file name */
  36.  
  37. static word llen = 0;        /* current output line length */
  38.  
  39. static char typech[MaxType+1];    /* output character for each type */
  40.  
  41. /* Define size of curlength table, and bias needed to access it. */
  42. /* Assumes all type codes are printable characters (or space).   */
  43. /* Smaller table is used if not EBCDIC.                          */
  44. #if !EBCDIC
  45. #define CurSize (127 - ' ')
  46. #define CurBias ' '
  47. #else                    /* !EBCDIC */
  48. #define CurSize 256
  49. #define CurBias 0
  50. #endif                    /* !EBCDIC */
  51.  
  52. static word curlength[CurSize];    /* current length for each output character */
  53.  
  54. /* line limit: start a new line when a command goes beyond this column */
  55. #define LLIM 70
  56.  
  57. /* mmchar(c): output character c and update the column counter */
  58. #define mmchar(c) (llen++,putc((c),monfile))
  59.  
  60. /* mmspace(): output unneeded whitespace whitespace following a command */
  61. /*  define as "mmchar(' ')" for readable files, or as "0" for compact ones */
  62. #define mmspace() 0
  63.  
  64. /*
  65.  * mmout(s) - write the given string to the MemMon file.
  66.  */
  67.  
  68. FncDcl(mmout,1)
  69.    {
  70.    char sbuf[MaxCvtLen];
  71.    int t;
  72.  
  73.    if ((t = defstr(&Arg1, sbuf, &emptystr)) == Error) 
  74.       RunErr(0, NULL);
  75.    /*
  76.     * Make sure Arg1 is a C-style string.
  77.     */
  78.    if (t == NoCvt)
  79.       qtos(&Arg1, sbuf);
  80.    MMOut("", StrLoc(Arg1));
  81.    Arg0 = nulldesc;
  82.    Return;
  83.    }
  84.  
  85. /*
  86.  * mmpause(s) - pause MemMon displaying string s.
  87.  */
  88.  
  89. FncDcl(mmpause,1)
  90.    {
  91.    char sbuf[MaxCvtLen];
  92.    int t;
  93.  
  94.    if ((t = defstr(&Arg1, sbuf, &emptystr)) == Error) 
  95.       RunErr(0, NULL);
  96.    if (StrLen(Arg1) == 0)
  97.       MMOut("; ", "programmed pause");
  98.    else {
  99.       /*
  100.        * Make sure Arg1 is a C-style string.
  101.        */
  102.       if (t == NoCvt)
  103.          qtos(&Arg1, sbuf);
  104.       MMOut("; ", StrLoc(Arg1));
  105.       }
  106.    Arg0 = nulldesc;
  107.    Return;
  108.    }
  109.  
  110. /*
  111.  * mmshow(x, s) - alter MemMon display of x depending on s.
  112.  */
  113.  
  114. FncDcl(mmshow,2)
  115.    {
  116.    char sbuf[MaxCvtLen];
  117.  
  118.    /*
  119.     * Default Arg2 to the empty string and make sure it is a C-style string.
  120.     */
  121.    switch (defstr(&Arg2, sbuf, &emptystr)) {
  122.  
  123.       case Cvt:   /* Already converted to a C-style string */
  124.          break;
  125.  
  126.       case Defaulted:
  127.       case NoCvt:
  128.          qtos(&Arg2, sbuf);
  129.          break;
  130.  
  131.       case Error:
  132.          RunErr(0, NULL);
  133.       }
  134.  
  135.    MMShow(&Arg1, StrLoc(Arg2));
  136.    Arg0 = nulldesc;
  137.    Return;
  138.    }
  139.  
  140. /*
  141.  * MMInit(filename) - initialization.
  142.  *
  143.  *  Memory monitoring is activated if the environment variable MEMMON is
  144.  *  non-null.  Its value names the output file;  or, under Unix, a value
  145.  *  beginning with "|" specifies a command to which the output is piped.
  146.  *
  147.  *  If MemMon is defined on a system lacking environment variables,
  148.  *  monitoring is always activated and output is to the file "memmon.out".
  149.  */
  150.  
  151. novalue MMInit(filename)
  152. char *filename;
  153.    {
  154.    int i;
  155.    FILE *f;
  156.    char time_buf[26];
  157.  
  158. #ifdef EnvVars
  159.    monname = getenv("MEMMON");
  160.    if (monname == NULL || strlen(monname) == 0)
  161.       return;
  162. #else                    /* EnvVars */
  163.    monname = "memmon.out";
  164. #endif                    /* EnvVars */
  165.  
  166. #if UNIX
  167.    if (monname[0] == '|')
  168.       f = popen(monname+1, "w");
  169.    else
  170. #endif                    /* UNIX */
  171.  
  172.       f = fopen(monname, "w");
  173.  
  174.    if (f == NULL) {
  175.       fprintf(stderr, "MEMMON: cannot open %s\n", monname);
  176.       fflush(stderr);
  177.       exit(ErrorExit);
  178.       }
  179.  
  180.  
  181.    getctime(time_buf);
  182.    fprintf(f, "##  Icon MemMon output\n");
  183.    fprintf(f, "#\n");
  184.    fprintf(f, "#   program: %s\n", filename);
  185.    fprintf(f, "#   date:    %s\n", time_buf);
  186.  
  187.    for (i = 0; i <= MaxType; i++)
  188.       typech[i] = '?';    /* initialize with error character */
  189.  
  190. #ifdef LargeInts
  191.    typech[T_Bignum]  = 'i';    /* long integer */
  192. #endif                    /* LargeInts */
  193.  
  194.    typech[T_Real]    = 'r';    /* real number */
  195.    typech[T_Cset]    = 'c';    /* cset */
  196.    typech[T_File]    = 'f';    /* file block */
  197.    typech[T_Record]  = 'R';    /* record block */
  198.    typech[T_Tvsubs]  = 'u';    /* substring trapped variable */
  199.    typech[T_External]= 'E';    /* external block */
  200.  
  201.    typech[T_List]    = 'L';    /* list header block */
  202.    typech[T_Lelem]   = 'l';    /* list element block */
  203.  
  204.    typech[T_Table]   = 'T';    /* table header block */
  205.    typech[T_Telem]   = 't';    /* table element block */
  206.    typech[T_Tvtbl]   = 'e';    /* table elem trapped variable*/
  207.  
  208.    typech[T_Set]     = 'S';    /* set header block */
  209.    typech[T_Selem]   = 's';    /* set element block */
  210.  
  211.    typech[T_Slots]   = 'h';    /* set/table hash slots */
  212.  
  213.    typech[T_Coexpr]  = 'X';    /* co-expression block (static region) */
  214.    typech[T_Refresh] = 'x';    /* co-expression refresh block */
  215.  
  216.    /*
  217.     * codes used elsewhere but not shown here:
  218.     *    in the static region: 'A' = alien (malloc block), 'F' = free
  219.     *    in the string region: '"' = string
  220.     */
  221.  
  222.    /*
  223.     * Set monfile to indicate that memmon is active.  Don't set it earlier
  224.     * than this, or we'll loop trying to trace the garbage collection that
  225.     * creates the buffer space.
  226.     */
  227.    monfile = f;
  228.    mmrefresh();            /* show current state */
  229.    fflush(monfile);        /* force it out */
  230.    }
  231.  
  232. /*
  233.  * MMTerm(part1, part2) - terminate memory monitoring.
  234.  *  part1 and part2 are concatentated to form an explanatory message.
  235.  */
  236.  
  237. novalue MMTerm(part1, part2)
  238. char *part1, *part2;
  239.    {
  240.    FILE *f;
  241.  
  242.    if (monfile == NULL)
  243.       return;
  244.    mmnewline();
  245.    mmsizes('=');        /* make a final check on region sizes */
  246.  
  247.    if (*part1 || *part2)    /* if any reason given, write it as comment */
  248.       fprintf(monfile, "# %s%s\n", part1, part2);
  249.  
  250.    f = monfile;
  251.    monfile = NULL;    /* so we don't try to show the freeing of the buffer */
  252.  
  253. #if UNIX
  254.    if (monname[0] == '|')
  255.       pclose(f);
  256.    else
  257. #endif                    /* UNIX */
  258.       fclose(f);
  259.    }
  260.  
  261. /*
  262.  * MMStat(a, n, c) - note static block at a, length n, represented by char 'c'.
  263.  * Output values are in basic units (typically words).
  264.  */
  265. novalue MMStat(a, n, c)
  266. char *a;
  267. word n;
  268. int c;
  269.    {
  270. #ifndef FixedRegions
  271.    if (monfile == NULL)
  272.       return;
  273.    mmcmd(DiffPtrs(a, statbase) / MMUnits, n / MMUnits, c);
  274. #endif                    /* FixedRegions */
  275.    }
  276.  
  277. /*
  278.  * MMAlc(len, type) - note an allocation at the end of the block region.
  279.  */
  280.  
  281. novalue MMAlc(len, type)
  282. word len;
  283. int type;
  284.    {
  285.    if (monfile == NULL)
  286.       return;
  287.    mmcmd((word)(-1), len / MMUnits, typech[type]);
  288.    }
  289.  
  290. /*
  291.  * MMStr(len) - note a string allocation at the end of the string region.
  292.  */
  293.  
  294. novalue MMStr(slen)
  295. word slen;
  296.    {
  297.    if (monfile == NULL)
  298.       return;
  299.    mmcmd((word)(-1), slen, '"');
  300.    }
  301.  
  302. /*
  303.  * MMBGC() - begin garbage collection.
  304.  */
  305.  
  306. novalue MMBGC(region)
  307. int region;
  308.    {
  309.    if (monfile == NULL)
  310.       return;
  311.    mmsizes('=');            /* write current sizes */
  312.    fprintf(monfile, "%d{\n", region);    /* indicate start of g.c. */
  313.    fflush(monfile);
  314.    mmforget();                /* clear memory of block sizes */
  315.    }
  316.  
  317. /*
  318.  * MMEGC() - end garbage collection.
  319.  */
  320.  
  321. novalue MMEGC()
  322.    {
  323.    if (monfile == NULL)
  324.       return;
  325.    mmnewline();
  326.    fprintf(monfile, "}\n");    /* indicate end of marking */
  327.    mmrefresh();            /* redraw regions after compaction */
  328.    fprintf(monfile, "!\n");    /* indicate end of g.c. */
  329.    fflush(monfile);
  330.    }
  331.  
  332. /*
  333.  * MMMark(block, type) - mark indicated block during garbage collection.
  334.  */
  335.  
  336. novalue MMMark(block, type)
  337. char *block;
  338. int type;
  339.    {
  340.    if (monfile == NULL)
  341.       return;
  342.    mmcmd(DiffPtrs(block, blkbase) / MMUnits, (word)BlkSize(block) / MMUnits,
  343.       typech[type]);
  344.    }
  345.  
  346. /*
  347.  * MMSMark - Mark String.
  348.  */
  349.  
  350. novalue MMSMark(saddr, slen)
  351. char *saddr;
  352. word slen;
  353.    {
  354.    if (monfile == NULL)
  355.       return;
  356.    mmcmd(DiffPtrs(saddr, strbase), slen, '"');
  357.    }
  358.  
  359. /*
  360.  * MMOut(prefix, msg) - write the prefix and message to the MemMon output file.
  361.  */
  362.  
  363. static novalue MMOut(prefix, msg)
  364. char *prefix, *msg;
  365.    {
  366.    if (monfile == NULL)
  367.       return;
  368.    mmnewline();
  369.    fprintf(monfile, "%s%s\n", prefix, msg);
  370.    }
  371.  
  372. /*
  373.  * MMShow(d, s) - redraw block indicated by descriptor d according to flags
  374.  *  in s.
  375.  */
  376.  
  377. novalue MMShow(d, s)
  378. dptr d;
  379. char *s;
  380.    {
  381.    char *block;
  382.    uword addr;
  383.    word len;
  384.    char cmd, tch;
  385.  
  386.    if (monfile == NULL)
  387.       return;
  388.    if (Qual(*d)) {
  389.       /*
  390.        *  Show a string.
  391.        */
  392. /*
  393.       if ((uword)StrLoc(*d)<(uword)strbase || (uword)StrLoc(*d)>=(uword)strend)
  394. */
  395.       if (!InRange(strbase,StrLoc(*d),strend))
  396.          return;    /* ignore if outside string region */
  397.       addr = DiffPtrs(StrLoc(*d), strbase);
  398.       len = StrLen(*d);
  399.       cmd = '$';
  400.       tch = '"';
  401.       }
  402.    else if (Type(*d)==T_Coexpr) {
  403.       /*
  404.        *  Show a coexpression block, which will be in the static region.
  405.        */
  406.       block = (char *)BlkLoc(*d);
  407.       addr = DiffPtrs(block, statbase) / MMUnits;
  408.       len = BlkSize(block) / MMUnits;
  409.       cmd = 'Y';
  410.       tch = typech[T_Coexpr];
  411.       }
  412.    else if (Pointer(*d)) {
  413.       /*
  414.        *  Show something in the block region.
  415.        */
  416.       block = (char *)BlkLoc(*d);
  417. /*
  418.       if ((uword)block < (uword)blkbase || (uword)block >= (uword)blkfree)
  419. */
  420.       if (!InRange(blkbase,block,blkfree))
  421.          return;    /* ignore if outside block region */
  422.       addr = DiffPtrs(block, blkbase) / MMUnits;
  423.       len = BlkSize(block) / MMUnits;
  424.       cmd = '%';
  425.       tch = typech[Type(*d)];
  426.       }
  427.  
  428.    mmdec(addr);            /* address */
  429.    mmchar('+');
  430.    mmlen(len, cmd);        /* length, and $ Y or % command */
  431.    if (s && *s)
  432.       mmchar(*s);        /* color flag from mmshow call */
  433.    else 
  434.       mmchar('r');        /* default color is 'r' (redraw) */
  435.    mmchar(tch);            /* block type character */
  436.    if (llen >= LLIM)
  437.       mmnewline();
  438.    else
  439.       mmspace();
  440.    }
  441.  
  442. /*
  443.  * mmrefresh() - redraw screen, initially or after garbage collection.
  444.  */
  445.  
  446. static novalue mmrefresh()
  447.    {
  448.    char *p;
  449.    word n;
  450.  
  451.    mmnewline();
  452.    mmsizes('<');            /* signal start of screen refresh */
  453.    mmnewline();
  454.    mmforget();                /* clear memory of past sizes */
  455.    mmstatic();                /* show the static region */
  456.    mmnewline();
  457.    for (p = blkbase; p < blkfree; p += n)
  458.       MMAlc(n = BlkSize(p), (int)BlkType(p));/* block region */
  459.    mmnewline();
  460.    MMStr(DiffPtrs(strfree, strbase));    /* string region */
  461.    mmnewline();
  462.    fprintf(monfile, ">\n");        /* signal end of refresh */
  463.    mmsizes('=');            /* confirm region sizes */
  464.    mmforget();                /* clear memory of past sizes */
  465.    }
  466.  
  467. /*
  468.  *  mmstatic() - recap the static region (stack, coexprs, aliens, free)
  469.  *   (this function is empty under FixedRegions)
  470.  */
  471. static novalue mmstatic()
  472.    {
  473. #ifndef FixedRegions
  474.    HEADER *p;
  475.    char *a;
  476.    int h;
  477.    word n;
  478.  
  479.    for (p = (HEADER *)statbase; (uword)p < (uword)(HEADER *)statfree;
  480.       p += p->s.bsize) {
  481.          a = (char *)(p + 1);
  482.          n = (p->s.bsize - 1) * sizeof(HEADER);
  483.          h = *(int *)a;
  484.          if (h == T_Coexpr || a == (char *)stack)
  485.             MMStat(a, n, 'X');        /* coexpression block */
  486.          else if (h == FREEMAGIC)
  487.             MMStat(a, n, 'F');        /* free block */
  488.          else
  489.             MMStat(a, n, 'A');        /* alien block */
  490.          }
  491.    a = (char *)p;
  492.    if (a < statend)
  493.       MMStat(a, (word)(statend-a), 'F');/* rest of static region is free */
  494. #endif                    /* FixedRegions */
  495.    }
  496.  
  497. /*
  498.  * mmsizes(c) - output current region sizes, with initial character c.
  499.  * If c is '<', the unit size is written ahead of it.
  500.  */
  501. static novalue mmsizes(c)
  502. int c;
  503.    {
  504.    mmnewline();
  505.    if (c == '<')
  506.       fprintf(monfile, "%d", MMUnits);
  507.    fprintf(monfile, "%c %lu:%lu/%lu %lu:%lu/%lu %lu:%lu/%lu\n", c,
  508.       /* static region; show as full, actual amount is unknown */
  509.       (unsigned long)statbase,
  510.       (unsigned long)DiffPtrs(statend, statbase),
  511.       (unsigned long)DiffPtrs(statend, statbase),
  512.       /* string region */
  513.       (unsigned long)strbase,
  514.       (unsigned long)DiffPtrs(strfree, strbase),
  515.       (unsigned long)DiffPtrs(strend, strbase),
  516.       /* block region */
  517.       (unsigned long)blkbase,
  518.       (unsigned long)DiffPtrs(blkfree, blkbase),
  519.       (unsigned long)DiffPtrs(blkend, blkbase));
  520.    }
  521.  
  522. /*
  523.  * mmcmd(addr, len, c) - output a memmon command.
  524.  *  If addr is < 0, it is omitted.
  525.  *  If len matches the previous value for command c, it is also omitted.
  526.  *  If the output fills the line, a following newline is written.
  527.  */
  528.  
  529. static novalue mmcmd(addr, len, c)
  530. word addr, len;
  531. int c;
  532.    {
  533.    if (addr >= 0) {
  534.       mmdec((uword)addr);
  535.       mmchar('+');
  536.       }
  537.    mmlen(len, c);
  538.    if (llen >= LLIM)
  539.       mmnewline();
  540.    else
  541.       mmspace();
  542.    }
  543.  
  544. /*
  545.  * mmlen(n, c) - output length n with character c.
  546.  * Omit the length if it matches the previous value for c.
  547.  */
  548. static novalue mmlen(n, c)
  549. word n;
  550. int c;
  551.    {
  552.    if (n != curlength[c-CurBias])
  553.       mmdec((uword)(curlength[c-CurBias] = n));
  554.    mmchar(c); 
  555.    }
  556.  
  557. /*
  558.  * mmdec(n) - output a decimal value, updating the line length.
  559.  */
  560. static novalue mmdec (n)
  561. uword n;
  562.    {
  563.    if (n > 9)
  564.       mmdec(n / 10);
  565.    n %= 10;
  566.    mmchar('0'+(int)n);
  567.    }
  568.  
  569. /*
  570.  * mmnewline() - output a newline and reset the line length.
  571.  */
  572. static novalue mmnewline()
  573.    {
  574.    if (llen > 0)  {
  575.       putc('\n', monfile);
  576.       llen = 0;
  577.       }
  578.    }
  579.  
  580. /*
  581.  * mmforget() - clear the history of remembered lengths.
  582.  */
  583. static novalue mmforget()
  584.    {
  585.    int c;
  586.  
  587.    for (c = 0; c < CurSize; c++)
  588.       curlength[c] = -1;
  589.    }
  590. #else                    /* MemMon */
  591. static char x;            /* avoid empty module */
  592. #endif                    /* MemMon */
  593.